home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
wedits22.zip
/
WEOUTPUT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-08-15
|
12KB
|
485 lines
UNIT WEOutput;
{ -- This is the Output Unit of WWIVEdit 2.2
-- Last Updated : 8/15/91
-- Written By:
-- Adam Caldwell
--
-- This Code is Limited Public Domain (see WWIVEdit.pas for details)
--
-- Purpose : Does the main output of WWIVEdit
--
-- Know Errors: None
--
-- Planned Enhancements: Adding Virtual Output
--
-- }
{$R-,V-,S-,B-,E-,N-} { These Optomize things as much as possible }
INTERFACE
CONST
Black = 0; { The Same Constants as defined in the CRT unit }
Blue = 1;
Green = 2;
Cyan = 3;
Red = 4;
Magenta = 5;
Brown = 6;
LightGray = 7;
DarkGray = 8;
LightBlue = 9;
LightGreen = 10;
LightCyan = 11;
LightRed = 12;
LightMagenta = 13;
Yellow = 14;
White = 15;
Blink = 128; { Ex: Textcolor(Red+Blink); }
c0 = ^C'0'; { Norm Color } { Short cuts FOR changing WWIV colors }
c1 = ^C'1'; { Yes/No Ans } { These should be used in conj. with Print }
c2 = ^C'2'; { Prompt } { and Prompt if you want them to be }
c3 = ^C'3'; { Note } { translated during the design phase of your}
c4 = ^C'4'; { Input Line } { program. }
c5 = ^C'5'; { Y/N Quest. }
c6 = ^C'6'; { Notice }
c7 = ^C'7'; { Border }
VAR
DisplayColor:char;
Translate : boolean;
PausePrompt : string;
PROCEDURE ClrScr;
PROCEDURE ClrEOL;
PROCEDURE ReverseVideoOn;
PROCEDURE ReverseVideoOff;
PROCEDURE Prompt(i:string);
PROCEDURE Print(i:string);
PROCEDURE Ansic(c:char);
PROCEDURE TextColor(c:byte);
PROCEDURE TextBackground(c:byte);
PROCEDURE GotoXY(x,y:byte);
FUNCTION WhereY:byte;
FUNCTION WhereX:byte;
PROCEDURE Center(s:string);
PROCEDURE nl;
PROCEDURE ReadScreen(VAR s:string; x,y:integer);
PROCEDURE WriteScreen(s:string; x,y,at:integer);
PROCEDURE WriteControl(ch:char);
PROCEDURE PauseScr;
PROCEDURE Redisplay;
PROCEDURE ForcedRedisplay;
PROCEDURE ShowHeader;
PROCEDURE ShowMaxLines;
PROCEDURE StatusLine1(s:string);
PROCEDURE StatusLine2(s:string);
PROCEDURE StatusLine3(s:string);
PROCEDURE ClrStatLine3;
PROCEDURE ClrStatLine2;
PROCEDURE PrintControlLine(s:string);
IMPLEMENTATION
USES DOS, WEString, WEKbd, WEVars, WELine, WETime;
TYPE
ScreenLine = ARRAY[1..80] OF RECORD
c : char;
a : byte;
END;
ScreenBuff = ARRAY[1..50] OF ScreenLine;
VAR
FG, BG : Integer;
WhereYFix:integer;
disp : ^ScreenBuff;
Blinking : boolean;
PROCEDURE ReverseVideoOn;
BEGIN
Prompt(ESC+'[7m');
END;
PROCEDURE ReverseVideoOff;
BEGIN
Prompt(ESC+'[87m');
END;
PROCEDURE DoColor(f,b : byte);
BEGIN
TextColor(f);
TextBackground(b);
END;
PROCEDURE Ansic(c:char);
{ New version of ANSIC requires a CHAR instead of an Int... it simplifies
using all the Color Mods out there }
BEGIN
IF NOT NoColor THEN
BEGIN
DisplayColor:=c;
IF Not Translate THEN prompt(^C+C);
CASE c OF
'0' : FG:=LightGray;
'1' : FG:=LightCyan;
'2' : FG:=Yellow;
'3' : FG:=Magenta;
'4' : BEGIN FG:=White; BG:=Blue END;
'5' : FG:=green;
'6' : FG:=LightRed+Blink;
'7' : FG:=LightBlue;
ELSE FG:=7;
END;
IF c<>'4' THEN BG:=Black;
IF Translate
THEN DoColor(FG,BG);
END;
END;
PROCEDURE WriteControl(ch:char);
{ Writes Ch in inverted colors... should be in the range [#0..#31] }
BEGIN
ReverseVideoOn;
Write(chr(ord(ch)+ord('@'))); { prints out H for ^H, etc }
ReverseVideoOff;
END;
PROCEDURE ClrEol;
BEGIN
write(#27,'[K')
END;
PROCEDURE TextColor(c : byte);
VAR
i : string;
intense : boolean;
BEGIN
i := #27+'[';
IF Blinking THEN
i:=i+'85;';
blinking:=c>=blink;
IF blinking THEN dec(c,blink);
intense:=c>7;
IF intense THEN
dec(c,8);
IF intense
THEN i := i+'1;'
ELSE i := i+'0;';
case c of
0 : i:=i+'30'; {Black/DarkGray}
1 : i:=i+'34'; {Blue/LightBlue}
2 : i:=i+'32'; {Green/LightGreen}
3 : i:=i+'36'; {Cyan/LightCyan}
4 : i:=i+'31'; {Red/LightRed}
5 : i:=i+'35'; {Magenta/LightMagenta}
6 : i:=i+'33'; {Brown/Yellow}
ELSE i:=i+'37'; {LightGrey/White}
END;
IF blinking THEN
i := i+';5';
i := i+'m';
write(i);
END;
PROCEDURE TextBackground(c : byte);
VAR i : string;
BEGIN
i := #27+'[';
IF c > 7 THEN dec(c,8);
case c of
0 : i := i+'40'; {Black/DarkGray}
1 : i := i+'44'; {Blue/LightBlue}
2 : i := i+'42'; {Green/LightGreen}
3 : i := i+'46'; {Cyan/LightCyan}
4 : i := i+'41'; {Red/LightRed}
5 : i := i+'45'; {Magenta/LightMagenta}
6 : i := i+'43'; {Brown/Yellow}
7 : i := i+'47'; {LightGrey/White}
END;
i := i+'m';
write(i);
END;
PROCEDURE Center(s:string);
BEGIN
writeln(' ':40-(lengthw(s) div 2),s);
END;
PROCEDURE prompt(i:string);
VAR c : integer; pp : byte; cc : char;
BEGIN
IF (i[1]=^B) AND Translate THEN BEGIN
delete(i,1,1);
write(#27+'['+cstr(40-(lengthw(i) div 2))+'C')
END;
IF NOT Translate THEN
write(i)
ELSE
FOR c := 1 TO length(i) DO
BEGIN
IF Translate AND (i[c] = #3) THEN
BEGIN
ansic(i[c+1]);
inc(c)
END
ELSE write(i[c]);
END;
END;
PROCEDURE nl;
BEGIN
prompt(#13#10);
END;
PROCEDURE print(i : string);
BEGIN
prompt(i);
nl;
END;
PROCEDURE clrscr;
BEGIN
Whereyfix:=0;
gotoxy(1,1);
ansic('0');
prompt(#27+'[2J');
WhereyFix:=WhereY-1;
END;
PROCEDURE gotoxy(x,y : byte);
BEGIN
write(#27,'[',y,';',x,'H');
END;
FUNCTION wherex : byte;
VAR
r:registers;
BEGIN
r.ah := 3;
r.bh := 0;
intr($10,r);
wherex := r.dl+1;
END;
FUNCTION WhereY : byte;
VAR
r:registers;
BEGIN
r.ah := 3;
r.bh := 0;
intr($10,r);
wherey := r.dh-WhereYFix+1;
END;
PROCEDURE WriteScreen(s:string; x,y,at:integer);
VAR
i:integer;
BEGIN
i:=x;
WHILE (i<80) AND (i-x+1<=length(s)) DO
WITH disp^[y+whereyfix][i] DO
BEGIN
c:=s[i-x+1];
a:=at;
inc(i);
END;
END;
PROCEDURE ReadScreen(VAR s:string; x,y:integer);
VAR
i:integer;
BEGIN
s:='';
FOR i:=x TO 80 DO
s:=s+disp^[y][i].c;
END;
PROCEDURE pausescr;
VAR
ch:char;
BEGIN
ansic('3'); prompt(PausePrompt);
Prompt(#27'['+cstr(lengthw(PausePrompt))+'D');
REPEAT UNTIL keypressed;
ch:=readkey;
clreol;
END;
PROCEDURE Redisplay;
{ This updates the physical display, does a pretty good job of not doing
more than it has to, but occasionally does... }
VAR
y, i : integer;
p : integer;
Shorter: boolean;
cc : char;
vp, py : integer;
BEGIN
cc := DisplayColor;
FOR y := ViewTop TO ViewBottom DO
IF y <= MaxLines THEN { If its a legal line and }
IF (Line[y]^.l <> screen[y - ViewTop + 1].l) OR { either the color or text}
(Line[y]^.c <> screen[y - viewtop + 1].c) THEN { has changed, then }
BEGIN { display the changes }
vp := y - ViewTop + 1; { The line corresponding to y in Screen[] }
py := y + WindowTop - ViewTop; { The physical screen line}
shorter:=length(Screen[vp].l) > length(Line[y]^.l); { used later on }
p := firstdiff(screen[vp], Line[y]^); { Find position of first }
FOR i := p TO len(y) DO { difference and then }
BEGIN { continue checking until }
IF (i > length(Screen[vp].l)) OR { EOL is reached }
(character(y,i) <> Screen[vp].l[i]) OR
(Color(Line[y]^,i) <> Color(Screen[vp],i)) THEN
BEGIN { If character is different}
IF NOT ((wherex = i) and (wherey = py)) THEN{ reposition as needed }
gotoxy(i,py);
IF cc <> Color(Line[y]^,i) THEN { change color if needed }
BEGIN
ansic(Line[y]^.c[i]);
cc := Color(Line[y]^,i);
END;
IF character(y,i) IN [#32..#255] { write character }
THEN write(character(y,i))
ELSE WriteControl(character(y,i));
END;
END; { for loop }
IF shorter THEN { If the line is shorter }
BEGIN
IF (wherex <> len(y) + 1) OR (wherey <> py) THEN
gotoxy(len(y) + 1, py); { move to the end of it }
cc:='0'; { Set Color to 0 }
Ansic('0'); { Clear to end of line }
clreol;
END;
screen[vp] := Line[y]^; { update screen array }
END;
IF DisplayColor <> CurrentColor THEN { Change color if needed }
Ansic(currentColor);
IF NOT ((wherex=cx) AND { reposition if needed }
(Wherey=cy+WindowTop-ViewTop)) THEN
gotoxy(cx,cy+WindowTop-ViewTop);
END;
PROCEDURE ForcedRedisplay;
{ This will make sure that the screen is redisplayed }
VAR x:integer;
BEGIN
ansic('0');
FOR x:=1 TO MaxPhyLines DO
initline(screen[x]);
clrscr;
ShowHeader;
Redisplay;
END;
PROCEDURE ShowHeader;
{ Prints the message header and also the Max Lines }
VAR i:integer;
BEGIN
ShowMaxLines;
IF ScreenState IN [0,2] THEN
BEGIN
gotoxy(1,1);
clreol; print(C2+'Title '+C1+': '+copy(Title,1,70)+C0);
IF ScreenState=0 THEN BEGIN
clreol; print(C2+'Dest '+C1+': '+copy(destination,1,70)+C0);
clreol; prompt(C2+'Time '+C1+': '+time);
gotoxy(40,wherey);
print(C2+'ESC'+C5+' to Save, '+C2+'CTRL-O'+C5+' for Help'+C0);
END;
clreol;
prompt('[');
FOR i:=2 TO LineLen-1 DO
IF i mod 10=0 THEN prompt(chr(i div 10+ord('0')))
ELSE IF i mod 5 =0 THEN prompt('|')
ELSE prompt('.');
print(']');
END;
END;
PROCEDURE ShowMaxLines;
VAR s:string;
BEGIN
s:=C7+'Max Lines '+C1+': '+cstr(MaxLines)+' '+C4;
IF InsertMode THEN s:=s+'Insert Mode' ELSE s:=s+'Overwrite Mode';
StatusLine2(s+C0);
IF Info.username <> '' THEN
WriteScreen(Info.UserName+' '+thisuser.name+' #'+
cstr(usernum),WhereX+2,Wherey,7);
END;
PROCEDURE StatusLine1(s:string);
VAR wx,wy:integer;
BEGIN
wx:=WhereX; wy:=Wherey;
gotoxy(1,WindowBottom+2);
clreol; prompt(s);
Gotoxy(wx,wy);
END;
PROCEDURE StatusLine2(s:string);
BEGIN
Gotoxy(1,WindowBottom+2);
clreol; prompt(s);
END;
PROCEDURE StatusLine3(s:string);
BEGIN
Gotoxy(1,WindowBottom+1);
clreol; prompt(s);
END;
VAR
savep_sx,savep_sy : byte;
PROCEDURE SaveP;
BEGIN
savep_sx:=wherex;
Savep_sy:=wherey;
END;
PROCEDURE RestoreP;
BEGIN
Gotoxy(savep_sx,savep_sy);
END;
PROCEDURE PrintControlLine(s:string);
VAR i:integer;
BEGIN
ansic('0');
FOR i:=1 TO length(s) DO
IF s[i] IN [#32..#255]
THEN write(s[i])
ELSE WriteControl(s[i]);
END;
{$F+} PROCEDURE ClrStatLine3; BEGIN SaveP; StatusLine3(C0); AfterNext:=DoNothing; RestoreP END; {$F+}
{$F+} PROCEDURE ClrStatLine2; BEGIN SaveP; StatusLine2(C0); AfterNext:=DoNothing; RestoreP END; {$F+}
VAR
i : integer;
BEGIN
Blinking:=False;
disp:=ptr($B800,0);
whereyfix:=0;
FOR i:=1 TO ParamCount DO
IF TransformString(ParamStr(i))='/MONO' THEN disp:=ptr($B000,0);
PausePrompt:='[PAUSE]';
END.